Games of Daze/Infomagic - Games of Daze (Summer 1995) (Disc 1 of 2).iso/x2ftp/msdos/utils/spriv101/spriter.pas

Pascal/Delphi Source File | 1994-12-13 | 66KB | 2,070 lines

{$G+}
uses    crt,dos;

type    muis=array[0..7,0..7] of byte;
        arr=array[1..60,0..31,0..31] of byte;
        woord=string[8];
        defr=array[0..2,0..4] of byte;
        cl=array[0..31,0..31] of byte;

const   deff='DEFAULT .IGA';
        pijl:array[0..4,0..4] of byte=((0,25,15,25,0),(25,15,15,15,25),
        (15,25,15,25,15),(0,0,15,0,0),(0,0,15,0,0));


var     kx1,ky1,kx2,ky2,kx3,ky3,kx4,ky4,kx5,ky5,x5,y5:integer;
        code,i,j,vx1,vy1,xje,ytje,xje2,ytje2:integer;
        scrn:array[0..199,0..319] of byte absolute $A000:0;
        rep,kad1,kleur1,kleur2,savclr,rkx1,rkx2,rky1,rky2:byte;
        k1,k2,k3,k4,k5,k6,k7,k8,k9,k10,chk1:byte;
        font2:array[' '..'Z',1..5,1..3] of byte;
        def:defr;
        t:array[0..255,1..3] of byte;
        keyss:array[0..127] of boolean;
        sel,zet,st:boolean;
        p:procedure;
        f:file;
        fil1,fil2:string[12];
        muisc:muis;
        bg:^muis;
        derf:^defr;
        pad:string;
        iga:arr;
        dum:string[2];
        dum2:array[1..2] of byte;
        dum3,dum4:byte;
        rgb:array[1..3] of byte;
        clip:^cl;

procedure writewoordje(x1,y1:integer;woordje:string;ts:byte); forward;

procedure setrgbpalette(c,teller,segm,offs:word); assembler;
            asm
               mov dx,$3C8
               mov ax,c
               out dx,al
               inc dx
               mov ds,segm
               mov si,offs
               mov cx,teller
               cld
               rep outsb
                {mov ax,1010h
                mov bx,[c]
                mov ch,[green]
                mov cl,[blue]
                mov dh,[red]
                int 10h}
            end;

procedure streef (b:byte;x,y:integer);
begin
str(b,dum);
if b<10 then dum:='0'+dum[1];
writewoordje(x,y,dum,2);
end;

{procedure setrgbblok;
var s,o:word;
begin
  s:=seg(t);o:=ofs(t);
  asm
    mov ax,1012h
    mov es,[s]
    mov dx,[o]
    mov bx,0
    mov cx,256
    int 10h
  end;
end;}

procedure initgr(bq:byte);assembler;   {zet in grafische mode nr. bq}
   asm
      mov ah,0
      mov al,[bq]
      int 10h
   end;

procedure resetmuis;          {zet de muis aan}
   var hax:word;
      begin
         asm
            mov ax,0
            int 33h
            mov hax,ax
         end;
         if hax<>0 then st:=true;
      end;

function muisx:integer;       {haalt de x-waarde van de muis}
   var w:word;
      begin
         asm
            mov ax,3
            int 33h
            mov [w],cx
         end;
         muisx:=w div 2;
      end;

function muisy:integer;       {haalt de y-waarde van de muis}
   var w:word;
      begin
         asm
            mov ax,3
            int 33h
            mov [w],dx
         end;
         muisy:=w;
      end;

function knop(b:byte):boolean;   {haalt de status van de knoppen}
   var w:word;                   {of ze ingedrukt zijn of niet}
      begin
         asm
            mov ax,3
            int 33h
            mov [w],bx
         end;
         case b of
            1:begin if w and 1=1 then knop:=true else knop:=false;end;
            2:begin if w and 2=2 then knop:=true else knop:=false;end;
            3:begin if w and 4=4 then knop:=true else knop:=false;end;
         end;
      end;

procedure zetmuisop(x1,y1:integer);assembler;
   asm                  {zet de muis op x,y virtueel beeld}
      mov ax,4
      mov cx,x1
      mov dx,y1
      int 33h
   end;

procedure xgrensmuis(x1,x2:integer); assembler;
   asm                   {bepaald de x-grenzen van de muis}
      mov ax,7
      mov cx,x1
      mov dx,x2
      int 33h
   end;

procedure ygrensmuis(y1,y2:integer); assembler;
   asm                   {bepaald de y-grenzen van de muis}
      mov ax,8
      mov cx,y1
      mov dx,y2
      int 33h
   end;

procedure zetrandkl(color:byte); assembler;
   asm                   {zet de randkleur(overscan)}
      mov ah,10h
      mov al,01h
      mov bh,[color]
      int 10h
   end;

procedure putpixel(x1:integer;y1,color:byte);
   begin                 {plaatst een pixel rechtstreeks i/h schermgeheugen}
      scrn[y1,x1]:=color
   end;

procedure getpixel(x1:integer;y1:byte);
   begin                 {haalt een pixel rechtstreeks u/h schermgeheugen}
      savclr:=scrn[y1,x1]
   end;

procedure zetpijlen(x,y:integer;richt:byte);
begin
   if richt=0 then {arrow-up}
   begin
   for i:=0 to 4 do
      for j:= 0 to 4 do
         if pijl[i,j]<>0 then putpixel(x+j,y+i,pijl[i,j]);
   end;
   if richt=1 then {arrow-down}
   begin
     for i:=4 downto 0 do
        for j:= 4 downto 0 do
           if pijl[i,j]<>0 then putpixel(x+4-j,y+4-i,pijl[i,j]);
   end;
   if richt=2 then  {arrow-left}
   begin
   for i:=0 to 4 do
      for j:= 0 to 4 do
         if pijl[i,j]<>0 then putpixel(x+i,y+j,pijl[i,j]);
   end;
   if richt=3 then {arrow-richt}
   begin
     for i:=4 downto 0 do
        for j:= 4 downto 0 do
           if pijl[i,j]<>0 then putpixel(x+4-i,y+4-j,pijl[i,j]);
   end;
end;

procedure kader(x1,x2:integer;y1,y2,color:byte);
   var x3:integer;
       y3,keer:byte;
      begin
         for keer:=1 to 2 do
            begin
               for x3:=x1 to x2 do
                  begin
                     putpixel(x3,y1,color);
                     putpixel(x3,y2,color);
                  end;
               for y3:=y1 to y2 do
                  begin
                     putpixel(x1,y3,color);
                     putpixel(x2,y3,color);
                  end;
               x1:=x1+1;x2:=x2-1;
               y1:=y1+1;y2:=y2-1;
            end;
      end;

procedure kader2(x1,x2:integer;y1,y2,color,soort:byte);
   var x3:integer;
       y3,keer:byte;
      begin
         for keer:=1 to 2 do
            begin
               for x3:=x1 to x2 do
                  begin
                     putpixel(x3,y1,color);
                  end;
               for y3:=y1 to y2 do
                  begin
                     putpixel(x1,y3,color);
                  end;
               x1:=x1+1;x2:=x2-1;
               y1:=y1+1;y2:=y2-1;
            end;
         x1:=x1-2;x2:=x2+2;
         y1:=y1-2;y2:=y2+2;
         if soort=0 then color:=120;
         if soort=1 then color:=189;
         for keer:=1 to 2 do
            begin
               for x3:=x1 to x2 do
                  begin
                     putpixel(x3,y2,color);
                  end;
               for y3:=y1 to y2 do
                  begin
                     putpixel(x2,y3,color);
                  end;
               x1:=x1+1;x2:=x2-1;
               y1:=y1+1;y2:=y2-1;
            end;
      end;

procedure keys; interrupt;
   var bt:byte;
      begin
         bt:=port[$60];
         if bt>128 then keyss[bt-128]:=false else keyss[bt]:=true;
         mem[$40:$1A]:=mem[$40:$1C];
         inline($9C);
         p;
      end;

procedure vulvlak(x1,x2:integer;y1,y2,color:byte);
   var x3:integer;
       y3:byte;
      begin
         for y3:=y1 to y2 do
         for x3:=x1 to x2 do
            begin
               putpixel(x3,y3,color);
            end;
      end;

procedure kadertje(x1,x2,y1,y2:integer;color:byte);
   var x3:integer;
       y3,keer:byte;
      begin
         for x3:=x1 to x2 do
            begin
               putpixel(x3,y1,color);
               putpixel(x3,y2,color);
            end;
         for y3:=y1 to y2 do
            begin
               putpixel(x1,y3,color);
               putpixel(x2,y3,color);
            end;
      end;

procedure lijnen(x,y:integer);
   var keer,keer2:integer;
      begin
         j:=x;
         for i:=0 to 255 do
            begin
               for keer:=1 to 4 do
               for keer2:= 1 to 4 do
                  begin
                     putpixel(x+keer,y+keer2,i)
                  end;
               if x<=214 then x:=x+5
                  else
                    begin
                       x:=j;
                       y:=y+5;
                    end;
            end;
      end;

procedure xlijn(x1,x2,y1:integer;color:byte);
   var x3:integer;
      begin
         for x3:=x1 to x2 do
         putpixel(x3,y1,color);
      end;

procedure ylijn(x1,y1,y2:integer;color:byte);
   var y3:integer;
      begin
        for y3:=y1 to y2 do
        putpixel(x1,y3,color);
      end;

procedure xschaal(x1,x2,y1:integer;color:byte);
   var keer:byte;
      begin
         for keer:= 1 to 33 do
            begin
               xlijn(x1,x2,y1,color);
               y1:=y1+4;
            end;
      end;

procedure yschaal(x1,y1,y2:integer;color:byte);
   var keer:byte;
      begin
         for keer:= 1 to 33 do
            begin
               ylijn(x1,y1,y2,color);
               x1:=x1+4;
            end;
      end;

procedure writerec;
   begin
      if ((vx1<>x5) or (vy1<>y5)) then
         begin
            for i:=0 to 7 do for j:=0 to 7 do
               begin
                  if scrn[j+vy1,i+vx1]=muisc[j,i] then scrn[j+vy1,i+vx1]:=bg^[j,i];
               end;
            vx1:=x5;vy1:=y5;
            for i:=0 to 7 do for j:=0 to 7 do
               begin
                  bg^[j,i]:=scrn[y5+j,x5+i];
                  if muisc[j,i]<>0 then scrn[j+y5,i+x5]:=muisc[j,i];
               end;
         end;
   end;

procedure muisje;
   begin
      for i:=0 to 7 do for j:=0 to 7 do if muisc[j,i]<>0 then scrn[j+y5,i+x5]:=muisc[j,i];
   end;

procedure writelettertje(x,y:integer;letter:char;tst:byte);
   var x1,y1:integer;
       kleur:byte;
      begin
         for y1 := 1 to 5 do
         for x1 := 1 to 3 do
            begin
               if tst=0 then kleur:=4;
               if tst=1 then kleur:=0;
               if tst=2 then kleur:=15;
               if tst=3 then kleur:=28;
               if letter='\' then letter:='/';
               if (font2[letter,y1,x1]<>0) then
               scrn[y+y1-1,x+x1-1]:=kleur;
               if (font2[letter,y1,x1]=25) then
               scrn[y+y1-1,x+x1-1]:=120;
            end;
      end;

procedure writewoordje(x1,y1:integer;woordje:string;ts:byte);
   begin
      for i:=0 to (length(woordje)-1) do
         begin
            writelettertje(x1+(i*4),y1,woordje[i+1],ts);
         end;
   end;

procedure indruk(x1,x2,y1,y2:integer;x3,y3:byte;tekst:woord);
   begin
      kader2(x1,x2,y1,y2,2,1);
      vulvlak(x1+2,x2-2,y1+2,y2-2,120);
      writewoordje(x3,y3,tekst,3);
      if tekst='' then zetpijlen(77,x3,y3);
         repeat
            if st=true then
               begin
                  for i:=0 to 7do for j:=0 to 7 do
                  if muisc[j,i]<>0 then scrn[j+y5,i+x5]:=muisc[j,i];
               end;
         until knop(1)=false;
      kader2(x1,x2,y1,y2,10,0);
      vulvlak(x1+2,x2-2,y1+2,y2-2,2);
      writewoordje(x3,y3,tekst,2);
      if tekst='' then zetpijlen(77,x3,y3);
      if st=true then
         begin
            for i:=0 to 7 do for j:=0 to 7 do
            if muisc[j,i]<>0 then scrn[j+y5,i+x5]:=muisc[j,i];
         end;
   end;

procedure saveicon;
var f1,f2:file;
    sub:array[0..127] of byte;
begin
assign(f1,'spriter.dat');
reset(f1,1);
seek(f1,1732);
assign(f2,pad+fil2);
rewrite(f2,1);
blockread(f1,sub,126);blockwrite(f2,sub,126);
for ytje:=31 downto 0 do
for xje:=0 to 15 do
begin
  i:=iga[k10,xje*2,ytje];
  i:=i shl 4;
  j:=iga[k10,xje*2+1,ytje];
  savclr:=i+j;
  blockwrite(f2,savclr,1);
  (*blockread(f,savclr,1);
  i:=(savclr div 16){+240};
  j:=(savclr mod 16){+240};
  if i=240 then i:=0;
  if j=240 then j:=0;
  putpixel((xje*2)+153,ytje+16,i);
  putpixel((xje*2)+154,ytje+16,j);
  ytje2:=(ytje)*4+5;
  vulvlak(xje*8+5,(xje*8)+7,ytje2,ytje2+2,i);
  vulvlak((xje*8)+9,(xje*8)+11,ytje2,ytje2+2,j);
  iga[k10,xje*2,ytje]:=i;
  iga[k10,xje*2+1,ytje]:=j;*)
end;
blockread(f1,sub,128);blockwrite(f2,sub,128);
close(f2);
close(f1);
end;

procedure save;
   var loop:byte;
       ch:char;
       dol:boolean;
       dim:string[4];
       x32,y32,aantal:byte;
      begin
         for i:=0 to 127 do keyss[i]:=false;
         indruk(5,31,144,154,11,147,'SAVE');
         vulvlak(150,308,88,104,2);
         if copy (fil2,sizeof(fil2)-3,3)='ICO'then saveicon else
         begin
         assign(f,pad+fil2);
         {$I-}
         reset(f,1);
         close(f);
         {$I+}
         if ioresult <> 0 then dol:=true else
            begin
               writewoordje(150,88,'WARNING: FILE ALREADY EXISTS.',0);
               writewoordje(150,94,'DO YOU WISH TO OVERWRITE <Y\N> ',1);
               writewoordje(150,100,pad+fil2,1);
                  repeat
                     if keyss[21] then
                        begin
                           writewoordje(262,94,'N',1);
                           writewoordje(254,94,'Y',2);
                           dol:=true;
                           keyss[21]:=false;
                        end;
                     if keyss[49] then
                        begin
                           writewoordje(254,94,'Y',1);
                           writewoordje(262,94,'N',2);
                           dol:=false;
                           keyss[49]:=false;
                        end;
                     if keyss[28] then j:=1;
                  until j=1;
               for i:=0 to 127 do keyss[i]:=false;
               vulvlak(150,308,88,104,2);
            end;
         if dol=true then
            begin
               {$I-}
               rewrite(f,1);
               {$I+}
               if ioresult <> 0 then
                  begin
                     writewoordje(150,88,'WRITE ERROR: PATH NOT FOUND.',0);
                     writewoordje(150,94,'UNABLE TO SAVE :',1);
                     writewoordje(150,100,pad+fil2,1);
                  end
                  else
                     begin
                        dim:='IGA';
                        aantal:=k9;
                        y32:=(rky2-rky1)+1;
                        x32:=(rkx2-rkx1)+1;
                        blockwrite(f,dim[1],3);
                        loop:=1;
                        blockwrite(f,loop,1);
                        blockwrite(f,aantal,1);
                        blockwrite(f,y32,1);
                        blockwrite(f,x32,1);
                         for aantal:=k7 to k8 do
                         for ytje:=rky1 to rky2 do
                           for xje:=rkx1 to rkx2 do

                           begin
                              blockwrite(f,iga[aantal{k10},xje,ytje],1);
                           end;
                        close(f);
                     end;
            end;
        end;
      end;


procedure quit;
   begin
      indruk(5,31,156,166,11,159,'QUIT');
      rep:=1;
      sel:=true;
      zet:=true;
   end;

procedure clear;
   begin
      indruk(5,31,174,184,9,177,'CLEAR');
      for ytje:=16 to 47 do
      for xje:=153 to 184 do
         begin
            iga[k10,xje-153,ytje-16]:=0;
            putpixel(xje,ytje,0);
            xje2:=(xje-153)*4+5;ytje2:=(ytje-16)*4+5;
            vulvlak(xje2,xje2+2,ytje2,ytje2+2,0);
         end;
      if st=true then
         begin
            for i:=0 to 7 do for j:=0 to 7 do
            if muisc[j,i]<>0 then scrn[j+y5,i+x5]:=muisc[j,i];
         end;
   end;

procedure cut;
   begin
      indruk(33,59,186,196,41,189,'CUT');
      for ytje:=rky1+16 to rky2+16 do
      for xje:=rkx1+153 to rkx2+153 do
         begin
            iga[k10,xje-153,ytje-16]:=0;
            putpixel(xje,ytje,0);
            xje2:=(xje-153)*4+5;ytje2:=(ytje-16)*4+5;
            vulvlak(xje2,xje2+2,ytje2,ytje2+2,0);
         end;
      if st=true then
         begin
            for i:=0 to 7 do for j:=0 to 7 do
            if muisc[j,i]<>0 then scrn[j+y5,i+x5]:=muisc[j,i];
         end;
   end;

procedure copie;
begin
  indruk(33,59,174,184,39,177,'COPY');
  for i:=0 to 31 do
    for j:=0 to 31 do
      clip^[i,j]:=0;
  dum2[1]:=rkx2-rkx1+1;
  dum2[2]:=rky2-rky1+1;
  for i:=0 to dum2[1] do
    for j:=0 to dum2[2] do
      clip^[i,j]:=iga[k10,rkx1+i,rky1+j];
end;

procedure paste;
begin
  kadertje((rkx1+1)*4,(rkx2+2)*4,(rky1+1)*4,(rky2+2)*4,123);
  indruk(5,31,186,196,9,189,'PASTE');
  rkx2:=rkx1+dum2[1]-1;
  if rkx2>31 then rkx2:=31;
  rky2:=rky1+dum2[2]-1;
  if rky2>31 then rky2:=31;
  for i:=0 to dum2[1]-1 do
    for j:=0 to dum2[2]-1 do
      begin
        if (rkx1+i<32) then
           if (rky1+j<32) then
           begin
           iga[k10,rkx1+i,rky1+j]:=clip^[i,j];
           putpixel(rkx1+i+153,rky1+j+16,clip^[i,j]);
           vulvlak(((rkx1+i+1)*4)+1,((rkx1+i+1)*4)+3,((rky1+j+1)*4)+1,((rky1+j+1)*4)+3,clip^[i,j])
           end else ;
      end;
kadertje((rkx1+1)*4,(rkx2+2)*4,(rky1+1)*4,(rky2+2)*4,4);
end;

procedure loadicon;
begin
reset(f,1);
for j:=1 to 126 do blockread(f,savclr,1);
{for i:=1 to 16 do begin blockread(f,rgb,3); setrgbpalette(i,rgb[1],rgb[2],rgb[3]);end;}
for ytje:=31 downto 0 do
for xje:=0 to 15 do
begin
  blockread(f,savclr,1);
  i:=(savclr div 16){+240};
  j:=(savclr mod 16){+240};
  if i=240 then i:=0;
  if j=240 then j:=0;
  putpixel((xje*2)+153,ytje+16,i);
  putpixel((xje*2)+154,ytje+16,j);
  ytje2:=(ytje)*4+5;
  vulvlak(xje*8+5,(xje*8)+7,ytje2,ytje2+2,i);
  vulvlak((xje*8)+9,(xje*8)+11,ytje2,ytje2+2,j);
  iga[k10,xje*2,ytje]:=i;
  iga[k10,xje*2+1,ytje]:=j;
end;
end;

procedure load;
   var loop1,loop2:byte;
       dim:string[4];
   begin
      indruk(33,59,144,154,39,147,'LOAD');
      vulvlak(150,308,88,104,2);
      if st=true then
         begin
            for i:=0 to 7 do for j:=0 to 7 do
            if muisc[j,i]<>0 then scrn[j+y5,i+x5]:=muisc[j,i];
         end;
      kadertje((rkx1+1)*4,(rkx2+2)*4,(rky1+1)*4,(rky2+2)*4,123);
      assign(f,pad+fil1);
      {$I-}
      reset(f,1);
      {$I+}
      if ioresult<>0 then
         begin
            writewoordje(150,88,'FILE NOT FOUND.',0);
            writewoordje(150,94,'UNABLE TO LOAD :',1);
            writewoordje(150,100,pad+fil1,1);
         end
         else
            if copy (fil1,sizeof(fil1)-3,3)='ICO'then loadicon else
            begin
               {for ytje:=16 to 47 do
               for xje:=153 to 184 do
                  begin
                     putpixel(xje,ytje,0);
                     xje2:=(xje-153)*4+5;ytje2:=(ytje-16)*4+5;
                     vulvlak(xje2,xje2+2,ytje2,ytje2+2,0);
                  end;}
               rkx1:=0;rky1:=0;
               blockread(f,dim,3);
               blockread(f,loop2,1);
               blockread(f,loop1,1);
               blockread(f,rky2,1);
               blockread(f,rkx2,1);
               rky2:=rky2-1;rkx2:=rkx2-1;
               if filesize(f)<>(((rkx2+1)*(rky2+1)*(loop1))+7) then
                  begin
                     writewoordje(150,88,'FORMAT NOT CORRECT.',0);
                     writewoordje(150,94,'UNABLE TO LOAD :',1);
                     writewoordje(150,100,pad+fil1,1);
                  end
                  else
                     begin
                        for loop2:=1 to loop1 do
                        for ytje:=rky1+16 to rky2+16 do
                        for xje:=rkx1+153 to rkx2+153 do
                           begin
                              blockread(f,savclr,1);
                              {putpixel(xje,ytje,savclr);
                              xje2:=(xje-153)*4+5;ytje2:=(ytje-16)*4+5;
                              vulvlak(xje2,xje2+2,ytje2,ytje2+2,savclr);}
                              iga[k10+loop2-1,xje-153,ytje-16]:=savclr;
                           end;
                        for ytje:=rky1+16 to rky2+16 do
                        for xje:=rkx1+153 to rkx2+153 do
                           begin
                             putpixel(xje,ytje,iga[k10,xje-153,ytje-16]);
                             xje2:=(xje-153)*4+5;ytje2:=(ytje-16)*4+5;
                             vulvlak(xje2,xje2+2,ytje2,ytje2+2,iga[k10,xje-153,ytje-16]);
                           end;
                     end;
               close(f);
            end;
      kadertje((rkx1+1)*4,(rkx2+2)*4,(rky1+1)*4,(rky2+2)*4,4);
   end;

procedure format;
   var rk:array[1..4] of integer;
       ooh,doen:boolean;
       rx1,ry1,rx2,ry2:integer;
       hlpx,hlpy,hlpx2,hlpy2:integer;
      begin
         rx1:=rkx1;rx2:=rkx2;ry1:=rky1;ry2:=rky2;
         indruk(33,59,156,166,39,159,'SIZE');
         kadertje((rkx1+1)*4,(rkx2+2)*4,(rky1+1)*4,(rky2+2)*4,123);
         writerec;
         if st=true then
            begin
               repeat
                  x5:=muisx;
                  y5:=muisy;
                  if knop(1) then doen:=true;
                  if (x5<4) or (x5>131) or (y5<4) or (y5>131) then doen:=false;
                  writerec;
                  if keyss[1] then
                     begin
                        ooh:=true;
                        doen:=true;
                     end;
               until doen=true;
               repeat
               until knop(1)=false;
               if ooh=false then doen:=false;
               rkx1:=round((x5-1) div 4)-1;
               rky1:=round((y5-1) div 4)-1;
               if ooh=false then
                  repeat
                     x5:=muisx;
                     y5:=muisy;
                     if knop(1)=true then doen:=true;
                     if (x5<4) or (x5>131) or (y5<4) or (y5>131) then doen:=false;
                     writerec;
                     if keyss[1] then
                        begin
                           keyss[1]:=false;
                           ooh:=true;
                           doen:=true;
                        end;
                  until doen=true;
               rkx2:=round((x5-1) div 4)-1;
               rky2:=round((y5-1) div 4)-1;
               repeat
               until knop(1)=false;
            end;
         if st=false then
            begin
               j:=1;
                  repeat
                     if (kx3<>kx4) or (ky3<>ky4) then
                        begin
                           kadertje(kx4,kx4+4,ky4,ky4+4,123);
                           kadertje(kx3,kx3+4,ky3,ky3+4,15);
                        end;
                     kx4:=kx3;ky4:=ky3;
                     if keyss[72] then
                        begin
                           ky3:=ky3-4;ky5:=ky5-1;
                           if ky3<4 then
                              begin
                                 ky3:=128;
                                 ky5:=47;
                              end;
                           keyss[72]:=false;
                        end;
                     if keyss[75] then
                        begin
                           kx3:=kx3-4;kx5:=kx5-1;
                           if kx3<4 then
                              begin
                                 kx3:=128;
                                 kx5:=184;
                              end;
                           keyss[75]:=false;
                        end;
                     if keyss[77] then
                        begin
                           kx3:=kx3+4;kx5:=kx5+1;
                           if kx3>128 then
                              begin
                                 kx3:=4;
                                 kx5:=153;
                              end;
                           keyss[77]:=false;
                        end;
                     if keyss[80] then
                        begin
                           ky3:=ky3+4;ky5:=ky5+1;
                           if ky3>128 then
                              begin
                                 ky3:=4;
                                 ky5:=16;
                              end;
                           keyss[80]:=false;
                        end;
                     if keyss[57] then
                        begin
                           if j=1 then
                              begin
                                 rkx1:=round((kx3-4) div 4);
                                 rky1:=round((ky3-4) div 4);
                              end;
                           if j=2 then
                              begin
                                 rkx2:=round((kx3-4) div 4);
                                 rky2:=round((ky3-4) div 4);
                                 doen:=true
                              end;
                           keyss[57]:=false;
                           j:=j+1;
                        end;
                     if keyss[1] then
                        begin
                           keyss[1]:=false;
                           ooh:=true;
                           doen:=true;
                        end;
                     kadertje(kx3,kx3+4,ky3,ky3+4,15);
                  until doen=true;
               kadertje(kx3,kx3+4,ky3,ky3+4,123);
               for i:=0 to 127 do
                  keyss[i]:=false;
            end;
         if ooh=true then
            begin
               rkx1:=rx1;rkx2:=rx2;rky1:=ry1;rky2:=ry2;
            end;
         if rkx1>rkx2 then
            begin
               hlpx:=rkx1;rkx1:=rkx2;rkx2:=hlpx;
            end;
         if rky1>rky2 then
            begin
               hlpy:=rky1;rky1:=rky2;rky2:=hlpy;
            end;
         kadertje((rkx1+1)*4,(rkx2+2)*4,(rky1+1)*4,(rky2+2)*4,4);
         vulvlak(302,310,155,161,0);
         vulvlak(302,310,165,171,0);
         vulvlak(274,282,155,161,0);
         vulvlak(274,282,165,171,0);
         vulvlak(247,255,155,161,0);
         vulvlak(247,255,165,171,0);
         k1:=rkx1+1;k2:=rkx2+1;k3:=k2-rkx1;
         k4:=rky1+1;k5:=rky2+1;k6:=k5-rky1;
         streef(k1,248,156);
         streef(k2,275,156);
         streef(k3,303,156);
         streef(k4,248,166);
         streef(k5,275,166);
         streef(k6,303,166);
         if st=true then writerec;
      end;

procedure roset;forward;

procedure rset;
   begin
      indruk(232,314,178,194,249,182,'reset');
      roset;
   end;

procedure muisweg;
   begin
      for i:=0 to 7 do for j:=0 to 7 do
         begin
            scrn[j+vy1,i+vx1]:=bg^[j,i];
         end;
   end;

procedure muisterug;
   begin
      for i:=0 to 7 do for j:=0 to 7 do
         begin
            bg^[j,i]:=scrn[j+vy1,i+vx1];
         end;
      muisje;
   end;

procedure haalnaam(x,y,b:integer;d:byte);
   var ch:char;
       ok:boolean;
       a:string[41];
      begin
         for i:=1 to b+3 do a[i]:=' ';
         if d=5 then for i:=1 to length(pad) do a[i]:=pad[i];
         {if d=6 then begin str(dum3,a); if dum3<10 then dum:='0'+dum[1]+'   ';end;}
         ok:=false;
         j:=1;
         if d=5 then if length(pad)<b then j:=length(pad)+1 else j:=b;
            repeat
               if d<>6 then
               begin
               if (d=5) and keyss[86] then
                  begin
                     ch:='\';
                     a[j]:=ch;
                     vulvlak((x+(j*4)),(x+3+(j*4)),y,y+5,0);
                     writelettertje((x+(j*4)),y,ch,2);
                     if j<b then j:=j+1;
                     keyss[86]:=false;
                  end;
               if (d=5) and keyss[52] then
                  begin
                     ch:=':';
                     a[j]:=ch;
                     vulvlak((x+(j*4)),(x+3+(j*4)),y,y+5,0);
                     writelettertje((x+(j*4)),y,ch,2);
                     if j<b then j:=j+1;
                     keyss[52]:=false;
                  end;
               if (d=5) and keyss[51] then
                  begin
                     ch:='.';
                     a[j]:=ch;
                     vulvlak((x+(j*4)),(x+3+(j*4)),y,y+5,0);
                     writelettertje((x+(j*4)),y,ch,2);
                     if j<b then j:=j+1;
                     keyss[51]:=false;
                  end;
               if (d=5) and keyss[83] then
                  begin
                     ch:='.';
                     a[j]:=ch;
                     vulvlak((x+(j*4)),(x+3+(j*4)),y,y+5,0);
                     writelettertje((x+(j*4)),y,ch,2);
                     if j<b then j:=j+1;
                     keyss[83]:=false;
                  end;
               if keyss[16] then
                  begin
                     ch:='A';
                     a[j]:=ch;
                     vulvlak((x+(j*4)),(x+3+(j*4)),y,y+5,0);
                     writelettertje((x+(j*4)),y,ch,2);
                     if j<b then j:=j+1;
                     keyss[16]:=false;
                  end;
               if keyss[17] then
                  begin
                     ch:='Z';
                     a[j]:=ch;
                     vulvlak((x+(j*4)),(x+3+(j*4)),y,y+5,0);
                     writelettertje((x+(j*4)),y,ch,2);
                     if j<b then j:=j+1;
                     keyss[17]:=false;
                  end;
               if keyss[18] then
                  begin
                     ch:='E';
                     a[j]:=ch;
                     vulvlak((x+(j*4)),(x+3+(j*4)),y,y+5,0);
                     writelettertje((x+(j*4)),y,ch,2);
                     if j<b then j:=j+1;
                     keyss[18]:=false;
                  end;
               if keyss[19] then
                  begin
                     ch:='R';
                     a[j]:=ch;
                     vulvlak((x+(j*4)),(x+3+(j*4)),y,y+5,0);
                     writelettertje((x+(j*4)),y,ch,2);
                     if j<b then j:=j+1;
                     keyss[19]:=false;
                  end;
               if keyss[20] then
                  begin
                     ch:='T';
                     a[j]:=ch;
                     vulvlak((x+(j*4)),(x+3+(j*4)),y,y+5,0);
                     writelettertje((x+(j*4)),y,ch,2);
                     if j<b then j:=j+1;
                     keyss[20]:=false;
                  end;
               if keyss[21] then
                  begin
                     ch:='Y';
                     a[j]:=ch;
                     vulvlak((x+(j*4)),(x+3+(j*4)),y,y+5,0);
                     writelettertje((x+(j*4)),y,ch,2);
                     if j<b then j:=j+1;
                     keyss[21]:=false;
                  end;
               if keyss[22] then
                  begin
                     ch:='U';
                     a[j]:=ch;
                     vulvlak((x+(j*4)),(x+3+(j*4)),y,y+5,0);
                     writelettertje((x+(j*4)),y,ch,2);
                     if j<b then j:=j+1;
                     keyss[22]:=false;
                  end;
               if keyss[23] then
                  begin
                     ch:='I';
                     a[j]:=ch;
                     vulvlak((x+(j*4)),(x+3+(j*4)),y,y+5,0);
                     writelettertje((x+(j*4)),y,ch,2);
                     if j<b then j:=j+1;
                     keyss[23]:=false;
                  end;
               if keyss[24] then
                  begin
                     ch:='O';
                     a[j]:=ch;
                     vulvlak((x+(j*4)),(x+3+(j*4)),y,y+5,0);
                     writelettertje((x+(j*4)),y,ch,2);
                     if j<b then j:=j+1;
                     keyss[24]:=false;
                  end;
               if keyss[25] then
                  begin
                     ch:='P';
                     a[j]:=ch;
                     vulvlak((x+(j*4)),(x+3+(j*4)),y,y+5,0);
                     writelettertje((x+(j*4)),y,ch,2);
                     if j<b then j:=j+1;
                     keyss[25]:=false;
                  end;
               if keyss[30] then
                  begin
                     ch:='Q';
                     a[j]:=ch;
                     vulvlak((x+(j*4)),(x+3+(j*4)),y,y+5,0);
                     writelettertje((x+(j*4)),y,ch,2);
                     if j<b then j:=j+1;
                     keyss[30]:=false;
                  end;
               if keyss[31] then
                  begin
                     ch:='S';
                     a[j]:=ch;
                     vulvlak((x+(j*4)),(x+3+(j*4)),y,y+5,0);
                     writelettertje((x+(j*4)),y,ch,2);
                     if j<b then j:=j+1;
                     keyss[31]:=false;
                  end;
               if keyss[32] then
                  begin
                     ch:='D';
                     a[j]:=ch;
                     vulvlak((x+(j*4)),(x+3+(j*4)),y,y+5,0);
                     writelettertje((x+(j*4)),y,ch,2);
                     if j<b then j:=j+1;
                     keyss[32]:=false;
                  end;
               if keyss[33] then
                  begin
                     ch:='F';
                     a[j]:=ch;
                     vulvlak((x+(j*4)),(x+3+(j*4)),y,y+5,0);
                     writelettertje((x+(j*4)),y,ch,2);
                     if j<b then j:=j+1;
                     keyss[33]:=false;
                  end;
               if keyss[34] then
                  begin
                     ch:='G';
                     a[j]:=ch;
                     vulvlak((x+(j*4)),(x+3+(j*4)),y,y+5,0);
                     writelettertje((x+(j*4)),y,ch,2);
                     if j<b then j:=j+1;
                     keyss[34]:=false;
                  end;
               if keyss[35] then
                  begin
                     ch:='H';
                     a[j]:=ch;
                     vulvlak((x+(j*4)),(x+3+(j*4)),y,y+5,0);
                     writelettertje((x+(j*4)),y,ch,2);
                     if j<b then j:=j+1;
                     keyss[35]:=false;
                  end;
               if keyss[36] then
                  begin
                     ch:='J';
                     a[j]:=ch;
                     vulvlak((x+(j*4)),(x+3+(j*4)),y,y+5,0);
                     writelettertje((x+(j*4)),y,ch,2);
                     if j<b then j:=j+1;
                     keyss[36]:=false;
                  end;
               if keyss[37] then
                  begin
                     ch:='K';
                     a[j]:=ch;
                     vulvlak((x+(j*4)),(x+3+(j*4)),y,y+5,0);
                     writelettertje((x+(j*4)),y,ch,2);
                     if j<b then j:=j+1;
                     keyss[37]:=false;
                  end;
               if keyss[38] then
                  begin
                     ch:='L';
                     a[j]:=ch;
                     vulvlak((x+(j*4)),(x+3+(j*4)),y,y+5,0);
                     writelettertje((x+(j*4)),y,ch,2);
                     if j<b then j:=j+1;
                     keyss[38]:=false;
                  end;
               if keyss[39] then
                  begin
                     ch:='M';
                     a[j]:=ch;
                     vulvlak((x+(j*4)),(x+3+(j*4)),y,y+5,0);
                     writelettertje((x+(j*4)),y,ch,2);
                     if j<b then j:=j+1;
                     keyss[39]:=false;
                  end;
               if keyss[44] then
                  begin
                     ch:='W';
                     a[j]:=ch;
                     vulvlak((x+(j*4)),(x+3+(j*4)),y,y+5,0);
                     writelettertje((x+(j*4)),y,ch,2);
                     if j<b then j:=j+1;
                     keyss[44]:=false;
                  end;
               if keyss[45] then
                  begin
                     ch:='X';
                     a[j]:=ch;
                     vulvlak((x+(j*4)),(x+3+(j*4)),y,y+5,0);
                     writelettertje((x+(j*4)),y,ch,2);
                     if j<b then j:=j+1;
                     keyss[45]:=false;
                  end;
               if keyss[46] then
                  begin
                     ch:='C';
                     a[j]:=ch;
                     vulvlak((x+(j*4)),(x+3+(j*4)),y,y+5,0);
                     writelettertje((x+(j*4)),y,ch,2);
                     if j<b then j:=j+1;
                     keyss[46]:=false;
                  end;
               if keyss[47] then
                  begin
                     ch:='V';
                     a[j]:=ch;
                     vulvlak((x+(j*4)),(x+3+(j*4)),y,y+5,0);
                     writelettertje((x+(j*4)),y,ch,2);
                     if j<b then j:=j+1;
                     keyss[47]:=false;
                  end;
               if keyss[48] then
                  begin
                     ch:='B';
                     a[j]:=ch;
                     vulvlak((x+(j*4)),(x+3+(j*4)),y,y+5,0);
                     writelettertje((x+(j*4)),y,ch,2);
                     if j<b then j:=j+1;
                     keyss[48]:=false;
                  end;
               if keyss[49] then
                  begin
                     ch:='N';
                     a[j]:=ch;
                     vulvlak((x+(j*4)),(x+3+(j*4)),y,y+5,0);
                     writelettertje((x+(j*4)),y,ch,2);
                     if j<b then j:=j+1;
                     keyss[49]:=false;
                  end;
               end;
               if keyss[71] then
                  begin
                     ch:='7';
                     a[j]:=ch;
                     vulvlak((x+(j*4)),(x+3+(j*4)),y,y+5,0);
                     writelettertje((x+(j*4)),y,ch,2);
                     if j<b then j:=j+1;
                     keyss[71]:=false;
                  end;
               if keyss[72] then
                  begin
                     ch:='8';
                     a[j]:=ch;
                     vulvlak((x+(j*4)),(x+3+(j*4)),y,y+5,0);
                     writelettertje((x+(j*4)),y,ch,2);
                     if j<b then j:=j+1;
                     keyss[72]:=false;
                  end;
               if keyss[73] then
                  begin
                     ch:='9';
                     a[j]:=ch;
                     vulvlak((x+(j*4)),(x+3+(j*4)),y,y+5,0);
                     writelettertje((x+(j*4)),y,ch,2);
                     if j<b then j:=j+1;
                     keyss[73]:=false;
                  end;
               if keyss[75] then
                  begin
                     ch:='4';
                     a[j]:=ch;
                     vulvlak((x+(j*4)),(x+3+(j*4)),y,y+5,0);
                     writelettertje((x+(j*4)),y,ch,2);
                     if j<b then j:=j+1;
                     keyss[75]:=false;
                  end;
               if keyss[76] then
                  begin
                     ch:='5';
                     a[j]:=ch;
                     vulvlak((x+(j*4)),(x+3+(j*4)),y,y+5,0);
                     writelettertje((x+(j*4)),y,ch,2);
                     if j<b then j:=j+1;
                     keyss[76]:=false;
                  end;
               if keyss[77] then
                  begin
                     ch:='6';
                     a[j]:=ch;
                     vulvlak((x+(j*4)),(x+3+(j*4)),y,y+5,0);
                     writelettertje((x+(j*4)),y,ch,2);
                     if j<b then j:=j+1;
                     keyss[77]:=false;
                  end;
               if keyss[79] then
                  begin
                     ch:='1';
                     a[j]:=ch;
                     vulvlak((x+(j*4)),(x+3+(j*4)),y,y+5,0);
                     writelettertje((x+(j*4)),y,ch,2);
                     if j<b then j:=j+1;
                     keyss[79]:=false;
                  end;
               if keyss[80] then
                  begin
                     ch:='2';
                     a[j]:=ch;
                     vulvlak((x+(j*4)),(x+3+(j*4)),y,y+5,0);
                     writelettertje((x+(j*4)),y,ch,2);
                     if j<b then j:=j+1;
                     keyss[80]:=false;
                  end;
               if keyss[81] then
                  begin
                     ch:='3';
                     a[j]:=ch;
                     vulvlak((x+(j*4)),(x+3+(j*4)),y,y+5,0);
                     writelettertje((x+(j*4)),y,ch,2);
                     if j<b then j:=j+1;
                     keyss[81]:=false;
                  end;
               if keyss[82] then
                  begin
                     ch:='0';
                     a[j]:=ch;
                     vulvlak((x+(j*4)),(x+3+(j*4)),y,y+5,0);
                     writelettertje((x+(j*4)),y,ch,2);
                     if j<b then j:=j+1;
                     keyss[82]:=false;
                  end;
               {if d<>6 then
               begin}
               if keyss[57] then
                  begin
                     if d<>6 then ch:=' ' else ch:='0';
                     a[j]:=ch;
                     vulvlak((x+(j*4)),(x+3+(j*4)),y,y+5,0);
                     writelettertje((x+(j*4)),y,ch,2);
                     if j<b then j:=j+1;
                     keyss[57]:=false;
                  end;
               if keyss[14] then
                  begin
                     if d<>6 then ch:=' ' else ch:='0';
                     vulvlak((x+(j*4)),(x+3+(j*4)),y,y+5,0);
                     if j>1 then j:=j-1;
                     if j+1>=b then if a[j+1]<>' ' then j:=j+1;
                     a[j]:=ch;
                     vulvlak((x+(j*4)),(x+3+(j*4)),y,y+5,0);
                     writelettertje((x+(j*4)),y,ch,2);
                     keyss[14]:=false;
                  end;
               {end;}
               if keyss[28] then ok:=true;
               writelettertje((x+(j*4)),y+3,'-',2);
            until ok;
         writelettertje((x+(j*4)),y+3,'-',1);
         for i:=0 to 127 do keyss[i]:=false;
         if d=1 then for i:=1 to b do fil1[i]:=a[i];
         if d=2 then for i:=1 to b do fil1[i+9]:=a[i];
         if d=3 then for i:=1 to b do fil2[i]:=a[i];
         if d=4 then for i:=1 to b do fil2[i+9]:=a[i];
         if d=5 then
            begin
               if pos('   ',a) > 0 then
                  pad := copy(a,1,pos('   ',a)-1);
               if length(pad)>0 then if pad[length(pad)]<> '\' then if length(pad)<38 then pad:=pad + '\'
               else pad[38]:='\';
            end;
         if d=6 then
         begin
         if pos(' ',a) > 0 then
                  a := copy(a,1,pos(' ',a)-1);
         val(a,dum3,code);
         end;
      end;

procedure input(x:integer);
   begin
      if st=true then muisweg;
      if (x>=200) and (x<=233) then
         begin
            vulvlak(200,233,62,68,0);
            haalnaam(197,63,8,1);
         end;
      if (x>=235) and (x<=251) then
         begin
            vulvlak(235,249,62,68,0);
            haalnaam(233,63,3,2);
         end;
      if st=true then
         begin
            muisterug;
            for i:=0 to 7 do for j:=0 to 7 do
            if muisc[j,i]<>0 then scrn[j+y5,i+x5]:=muisc[j,i];
         end;
   end;

procedure output(x:integer);
   begin
      if st=true then muisweg;
      if (x>=255) and (x<=286) then
         begin
            vulvlak(255,286,62,68,0);
            haalnaam(252,63,8,3);
         end;
      if (x>=290) and (x<=304) then
         begin
            vulvlak(290,302,62,68,0);
            haalnaam(288,63,3,4);
         end;
      if st=true then
         begin
            muisterug;
            for i:=0 to 7 do for j:=0 to 7 do
            if muisc[j,i]<>0 then scrn[j+y5,i+x5]:=muisc[j,i];
         end;
   end;

procedure padput;
   begin
      if st=true then muisweg;
      haalnaam(149,120,38,5);
      vulvlak(151,305,119,125,0);
      writewoordje(153,120,pad,2);
      if st=true then muisterug;
   end;

{procedure selectkleur;
   begin
      repeat
         if rep<>1 then else exit;
         if (kx1<>kx2) or (ky1<>ky2) then
            begin
               kadertje(kx2,kx2+5,ky2,ky2+5,0);
            end;
         kx2:=kx1;ky2:=ky1;
         if keyss[72] then
            begin
               ky1:=ky1-5;
               if (ky1<144) and (kx1>196) then ky1:=184
                  else
                     if ky1<144 then ky1:=189;
               keyss[72]:=false;
               if (kleur1>21) and (kleur1<26) then kleur1:=kleur1+(8*26)
                  else
                     if (kleur1>=0) and (kleur1<22) then kleur1:=kleur1+(9*26)
                        else kleur1:=kleur1-26;
            end;
         if keyss[75] then
            begin
               kx1:=kx1-5;
               if (kx1<91) and (ky1=189) then kx1:=196
                  else
                     if kx1<91 then kx1:=216;
               keyss[75]:=false;
               if kleur1=234 then kleur1:=kleur1+21
                  else
                     if (kleur1=0) or (kleur1=26) or (kleur1=52) or (kleur1=78)
                     or (kleur1=104) or (kleur1=130) or (kleur1=156) or (kleur1=182)
                     or (kleur1=208) then kleur1:=kleur1+25
                        else
                           kleur1:=kleur1-1;
            end;
         if keyss[77] then
            begin
               kx1:=kx1+5;
               if (kx1>196) and (ky1=189) then kx1:=91
                  else
                     if kx1>216 then kx1:=91;
               keyss[77]:=false;
               if kleur1=255 then kleur1:=kleur1-21
                  else
                     if (kleur1=25) or (kleur1=51) or (kleur1=77) or (kleur1=103)
                     or (kleur1=129) or (kleur1=155) or (kleur1=181)
                     or (kleur1=207) or (kleur1=233) then kleur1:=kleur1-25
                        else
                           kleur1:=kleur1+1;
            end;
         if keyss[80] then
            begin
               ky1:=ky1+5;
               if (kx1>196) and (ky1>184) then ky1:=144
                  else
                     if ky1>189 then ky1:=144;
               keyss[80]:=false;
               if (kleur1<=233) and (kleur1>229) then kleur1:=kleur1-(8*26)
                  else
                     if (kleur1<=255) and (kleur1>233) then kleur1:=kleur1-(9*26)
                        else kleur1:=kleur1+26;
            end;
         if keyss[15] then
            begin
               sel:=true;
               keyss[15]:=false;
            end;
         if keyss[30] or keyss[1] then
            begin
               quit;
            end;
         kadertje(kx1,kx1+5,ky1,ky1+5,15);
         vulvlak(173,183,57,65,kleur1);
      until sel=true;
      sel:=false;
      for i:=0 to 127 do
         keyss[i]:=false;
   end;}

{procedure zetkleur;
   begin
      repeat
         if (kx3<>kx4) or (ky3<>ky4) then
            begin
               kadertje(kx4,kx4+4,ky4,ky4+4,123);
               kadertje((rkx1+1)*4,(rkx2+2)*4,(rky1+1)*4,(rky2+2)*4,4);
               kadertje(kx3,kx3+4,ky3,ky3+4,15);
            end;
         kx4:=kx3;ky4:=ky3;
         if keyss[72] then
            begin
               ky3:=ky3-4;ky5:=ky5-1;
               if ky3<4 then
                  begin
                     ky3:=128;
                     ky5:=47;
                  end;
               keyss[72]:=false;
            end;
         if keyss[75] then
            begin
               kx3:=kx3-4;kx5:=kx5-1;
               if kx3<4 then
                  begin
                     kx3:=128;
                     kx5:=184;
                  end;
               keyss[75]:=false;
            end;
         if keyss[77] then
            begin
               kx3:=kx3+4;kx5:=kx5+1;
               if kx3>128 then
                  begin
                     kx3:=4;
                     kx5:=153;
                  end;
               keyss[77]:=false;
            end;
         if keyss[80] then
            begin
               ky3:=ky3+4;ky5:=ky5+1;
               if ky3>128 then
                  begin
                     ky3:=4;
                     ky5:=16;
                  end;
               keyss[80]:=false;
            end;
         if keyss[57] then
            begin
               vulvlak(kx3+1,kx3+3,ky3+1,ky3+3,kleur1);
               putpixel(kx5,ky5,kleur1);
            end;
         if keyss[14] then
            begin
               vulvlak(kx3+1,kx3+3,ky3+1,ky3+3,0);
               putpixel(kx5,ky5,0);
            end;
         if keyss[31] then
            begin
               save;
               keyss[31]:=false;
            end;
         if keyss[38] then
            begin
               load;
               keyss[38]:=false;
            end;
         if keyss[33] then
            begin
               kadertje((rkx1+1)*4,(rkx2+2)*4,(rky1+1)*4,(rky2+2)*4,123);
               format;
               keyss[33]:=false;
               kadertje((rkx1+1)*4,(rkx2+2)*4,(rky1+1)*4,(rky2+2)*4,4);
            end;
         if keyss[15] then
            begin
               keyss[15]:=false;
               zet:=true;
            end;
         if keyss[23] then
            begin
               keyss[23]:=false;
               input(201);
               input(236);
            end;
         if keyss[24] then
            begin
               keyss[24]:=false;
               output(256);
               output(291);
            end;
         if keyss[19] then
            begin
               rset;
               keyss[19]:=false;
            end;
         if keyss[46] then
            begin
               clear;
               keyss[46]:=false;
            end;
         if keyss[30] or keyss[1] then
            begin
               keyss[30]:=false;
               keyss[1]:=false;
               quit;
            end;
         if keyss[25] then
            begin
               keyss[25]:=false;
               padput;
            end;
         kadertje(kx3,kx3+4,ky3,ky3+4,15);
      until zet=true;
      zet:=false;
      for i:=0 to 127 do
         keyss[i]:=false;
   end;}

procedure getit;
begin
for ytje:=0 to 2 do
for xje:=0 to 4 do
begin
getpixel(77+xje,chk1+ytje);
derf^[ytje,xje]:=savclr;
end;
end;

procedure putit;
begin
for ytje:=0 to 2 do
for xje:=0 to 4 do
putpixel(77+xje,chk1+ytje,derf^[ytje,xje]);
end;

procedure zetdef;
var y38,x38:byte;
begin
  putit;
  y38 := 153+round((k10)/2);x38:=77;
  getit;
  for ytje:=0 to 2 do
  for xje:=0 to 4 do
  if def[ytje,xje]<>0 then putpixel(x38+xje,y38+ytje,def[ytje,xje]);
  chk1:=y38;
end;

procedure scherm;
   begin
      kader(0,136,0,138,2);               {Hoofdkader rond raster}
      kader(2,134,2,136,2);               {Overlappend 2de kader rond raster}
      kader(137,319,0,138,2);             {Kader rond help, etc.}
      kader(139,317,2,136,2);
      kader(141,315,4,134,2);
      kader2(143,313,6,132,49,0);
      kader2(146,192,9,74,49,0);
      kader(148,190,11,72,2);
      kader(150,188,13,70,2);
      kadertje(152,185,15,48,4);
      xlijn(152,185,49,2);
      ylijn(186,15,49,2);
      kader(152,186,50,53,2);
      kader2(146,310,76,129,49,0);
      kader2(194,310,9,74,49,0);
      vulvlak(148,308,78,127,2);
      vulvlak(196,308,11,72,2);
      kader(0,85,139,199,2);
      kader2(2,62,141,169,49,0);
      vulvlak(63,84,141,197,2);
      xlijn(2,62,170,2);
      kader2(2,62,171,199,49,0);
      kader(86,226,139,199,2);
      kader(169,170,51,72,2);
      kader2(170,186,54,68,49,0);
      kader2(152,168,54,68,49,0);
      kader2(88,224,141,197,49,0);
      kader2(5,31,144,154,49,0);
      kader2(33,59,144,154,49,0);
      kader2(5,31,156,166,49,0);
      kader2(33,59,156,166,49,0);
      kader2(5,31,174,184,49,0);
      kader2(33,59,174,184,49,0);
      kader2(5,31,186,196,49,0);
      kader2(33,59,186,196,49,0);
      kader2(74,84,140,150,49,0);{pijlenkader}
      ylijn(79,152,187,0);
      {vulvlak(77,81,155,183,0);}
      zetpijlen(77,143,0);
      kader2(74,84,151,188,49,0);
      kader2(74,84,189,199,49,0);
      zetpijlen(77,192,1);
      kadertje(73,85,139,199,0);
      kadertje(62,73,164,174,0);
      kadertje(63,73,165,173,49);
      vulvlak(64,72,166,172,0);
      streef(k10,65,167);
      {writewoordje(66,167,k10,2);}
      vulvlak(7,29,146,152,2);
      vulvlak(35,57,146,152,2);
      vulvlak(7,29,158,164,2);
      vulvlak(35,57,158,164,2);
      vulvlak(7,29,176,182,2);
      vulvlak(35,57,176,182,2);
      vulvlak(7,29,188,194,2);
      vulvlak(35,57,188,194,2);
      writewoordje(11,147,'SAVE',2);
      writewoordje(39,147,'LOAD',2);
      writewoordje(11,159,'QUIT',2);
      writewoordje(39,159,'SIZE',2);
      writewoordje(9,177,'CLEAR',2);
      writewoordje(39,177,'COPY',2);
      writewoordje(9,189,'PASTE',2);
      writewoordje(41,189,'CUT',2);
      kader(227,319,139,199,2);
      kader2(229,317,141,197,49,0);
      vulvlak(231,315,143,195,2);
      kadertje(3,133,3,134,0);
      kadertje(172,184,56,66,4);
      kadertje(154,166,56,66,4);
      xlijn(3,133,134,2);
      lijnen(91,144);
      xschaal(4,132,4,123);
      yschaal(4,4,132,123);
      kadertje((rkx1+1)*4,(rkx2+2)*4,(rky1+1)*4,(rky2+2)*4,4);
      zetrandkl(2);
      writewoordje(210,14,'INSECABILIS PRESENTS:',0);
      xlijn(210,292,20,15);
      writewoordje(214,22,'SPRITE-EDITOR V1.01',1);
      xlijn(197,307,28,15);
      writewoordje(234,30,'CODED BY:',0);
      xlijn(234,268,36,15);
      writewoordje(234,38,'DISCORDIS',1);
      writewoordje(220,44,'(=DIMITRI SMITS)',1);
      xlijn(197,307,12,15);
      xlijn(197,307,50,15);
      xlijn(197,307,51,15);
      ylijn(252,52,70,15);
      xlijn(197,307,71,15);
      ylijn(197,52,70,15);
      ylijn(307,52,70,15);
      writewoordje(205,53,'INPUTFILE:',2);
      writewoordje(258,53,'OUTPUTFILE:',2);
      xlijn(198,306,59,15);
      vulvlak(200,249,62,68,0);
      vulvlak(255,304,62,68,0);
      writewoordje(201,63,fil1,2);
      writewoordje(256,63,fil2,2);
      ylijn(234,62,68,2);
      ylijn(289,62,68,2);
      writewoordje(150,80,'MESSAGES:',2);
      xlijn(150,184,86,15);
      xlijn(149,307,107,15);
      writewoordje(150,110,'PATH:',2);
      xlijn(150,168,116,15);
      vulvlak(151,305,119,125,0);
      writewoordje(153,120,pad,2);
      xlijn(232,314,144,15);
      xlijn(232,314,145,15);
      ylijn(232,145,191,15);
      ylijn(314,145,191,15);
      writewoordje(236,147,'FILE-INFO FOR SAVE:',1);
      xlijn(232,314,153,15);
      writewoordje(236,156,'X1:',2);
      ylijn(259,153,172,15);
      writewoordje(263,156,'X2:',2);
      ylijn(286,153,172,15);
      xlijn(232,314,163,15);
      writewoordje(236,166,'Y1:',2);
      writewoordje(263,166,'Y2:',2);
      writewoordje(290,156,'>',0);
      writewoordje(290,166,'>',0);
      writewoordje(294,156,'X:',2);
      writewoordje(294,166,'Y:',2);
      xlijn(232,314,173,15);
      xlijn(232,314,174,15);
      xlijn(232,314,182,15);
      xlijn(232,314,192,15);
      vulvlak(302,310,155,161,0);
      vulvlak(302,310,165,171,0);
      vulvlak(274,282,155,161,0);
      vulvlak(274,282,165,171,0);
      vulvlak(247,255,155,161,0);
      vulvlak(247,255,165,171,0);
      vulvlak(254,262,184,190,0);
      vulvlak(278,286,184,190,0);
      vulvlak(302,310,184,190,0);
      streef(k1,248,156);
      streef(k2,275,156);
      streef(k3,303,156);
      streef(k4,248,166);
      streef(k5,275,166);
      streef(k6,303,166);
      streef(k7,255,185);
      streef(k8,279,185);
      streef(k9,303,185);
      writewoordje(249,176,'PICS TO SAVE:',1);
      writewoordje(235,185,'FROM:   TO:    =',2);
      ylijn(264,183,191,15);
      ylijn(288,183,191,15);
      getit;
      zetdef;
   end;

procedure zetkl(x,y:integer;kleur:byte);
   var x1,y1:longint;
       x2,y2:integer;
      begin
         x1:=(trunc((x-4)/4)*4+4);
         y1:=(trunc((y-4)/4)*4+4);
         muisweg;
         vulvlak(x1+1,x1+3,y1+1,y1+3,kleur);
         muisterug;
         muisje;
         x2:=(x1 div 4)+152;y2:=(y1 div 4)+15;
         putpixel(x2,y2,kleur);
         x2:=(x1-1) div 4;y2:=(y1-1) div 4;
         iga[k10,x2,y2]:=kleur;
      end;

procedure haalkl(x,y:integer;c:byte);
   var x1,y1:longint;
      begin
         if (x>=200) and (x<=220) and (y>=188) and (y<=193) then else
         begin
         x1:=(trunc((x-91) div 5)*5)+92;
         y1:=(trunc((y-144) div 5)*5)+145;
         if c=1 then
            begin
               kleur1:=scrn[y1,x1];
               vulvlak(155,165,57,65,kleur1);
            end;
         if c=2 then
            begin
               kleur2:=scrn[y1,x1];
               vulvlak(173,183,57,65,kleur2);
            end;
        end;
      end;

procedure schrijfin(x9,y9:integer;var g:byte);
begin
   muisweg;
   dum3:=g;
   if (g=k1) or (g=k2) or (g=k4) or (g=k5) then kadertje((rkx1+1)*4,(rkx2+2)*4,(rky1+1)*4,(rky2+2)*4,123);
   haalnaam(x9-3,y9+1,2,6);
   if (g=k10) or (g=k7) or (g=k8) then if dum3>60 then g:=60 else if dum3<1 then g:=1 else g:=dum3;
   if (g=k1) or (g=k2) or (g=k4) or (g=k5) then if dum3>32 then g:=32 else if dum3<1 then g:=1 else g:=dum3;
   vulvlak(x9,x9+8,y9,y9+6,0);
   streef(g,x9+1,y9+1);
   if (g=k1) or (g=k2) or (g=k4) or (g=k5) then
     begin
     if k1>k2 then begin dum4:=k1;k1:=k2;k2:=dum4;end;
     if k4>k5 then begin dum4:=k4;k4:=k5;k5:=dum4;end;
     k3:=k2-k1+1;
     k6:=k5-k4+1;
     rkx1:=k1-1;
     rkx2:=k2-1;
     rky1:=k4-1;
     rky2:=k5-1;
     vulvlak(302,310,155,161,0);
     vulvlak(302,310,165,171,0);
     vulvlak(274,282,155,161,0);
     vulvlak(274,282,165,171,0);
     vulvlak(247,255,155,161,0);
     vulvlak(247,255,165,171,0);
     streef(k1,248,156);
     streef(k2,275,156);
     streef(k3,303,156);
     streef(k4,248,166);
     streef(k5,275,166);
     streef(k6,303,166);
     kadertje((rkx1+1)*4,(rkx2+2)*4,(rky1+1)*4,(rky2+2)*4,4);
     end;
     if g=k7 then
        begin
          k9:=k8-k7+1;
          vulvlak(302,310,184,190,0);
          streef(k9,303,185);
        end;
     if g=k8 then
        begin
          k9:=k8-k7+1;
          vulvlak(302,310,184,190,0);
          streef(k9,303,185);
        end;
     if g=k10 then
    begin
    for i:=0 to 31 do
     for j:=0 to 31 do
        begin
          putpixel(j+153,i+16,iga[k10,j,i]);
          xje2:=j*4+5;ytje2:=i*4+5;
          vulvlak(xje2,xje2+2,ytje2,ytje2+2,iga[k10,j,i]);
        end;
   zetdef;
   end;

   muisterug;
end;

procedure knopbov;
begin
  indruk(74,84,140,150,143,0,'');
  if k10<>1 then k10:=k10-1 else k10:=1;
  vulvlak(64,72,166,172,0);
  streef(k10,65,167);
  for i:=0 to 31 do
     for j:=0 to 31 do
        begin
          putpixel(j+153,i+16,iga[k10,j,i]);
          xje2:=j*4+5;ytje2:=i*4+5;
          vulvlak(xje2,xje2+2,ytje2,ytje2+2,iga[k10,j,i]);
        end;
  zetdef;
end;

procedure knopond;
begin
  indruk(74,84,189,199,192,1,'');
  if k10<>60 then k10:=k10+1 else k10:=60;
  vulvlak(64,72,166,172,0);
  streef(k10,65,167);
  for i:=0 to 31 do
     for j:=0 to 31 do
       begin
         putpixel(j+153,i+16,iga[k10,j,i]);
         xje2:=j*4+5;ytje2:=i*4+5;
         vulvlak(xje2,xje2+2,ytje2,ytje2+2,iga[k10,j,i]);
       end;
  zetdef;
end;

{procedure knopje;
var compje:shortint;
begin
  repeat
  muisweg;
  compje:=(muisy-139);
  if compje+14>1 then k10:=compje+14 else k10:=1;
  if k10>60 then k10:=60;
  vulvlak(64,72,166,172,0);
  streef(k10,65,167);
  for i:=0 to 31 do
     for j:=0 to 31 do
       begin
         putpixel(j+153,i+16,iga[k10,j,i]);
         xje2:=j*4+5;ytje2:=i*4+5;
         vulvlak(xje2,xje2+2,ytje2,ytje2+2,iga[k10,j,i]);
       end;
  zetdef;
  muisterug;
  until (knop(1)=false) and (knop(2)=false);
end;}

procedure checkleft(x,y:integer;kn:byte);
   begin
      if (x>=5) and (x<=132) and (y>=5) and (y<=132) then if kn=1 then zetkl(x-1,y-1,kleur1) else zetkl(x-1,y-1,kleur2);;
      if (x>=91) and (x<=220) and (y>=144) and (y<=193) then if kn=1 then haalkl(x,y,kn) else haalkl(x,y,kn);
      if (x>=6) and (x<=32) and (y>=145) and (y<=155) then save;
      if (x>=34) and (x<=60) and (y>=145) and (y<=155) then load;
      if (x>=6) and (x<=32) and (y>=157) and (y<=167) then quit;
      if (x>=34) and (x<=60) and (y>=157) and (y<=167) then format;
      if (x>=6) and (x<=32) and (y>=175) and (y<=185) then clear;
      if (x>=34) and (x<=60) and (y>=175) and (y<=185) then copie;
      if (x>=6) and (x<=32) and (y>=187) and (y<=197) then paste;
      if (x>=34) and (x<=60) and (y>=187) and (y<=197) then cut;
      if (x>=198) and (x<=251) and (y>=52) and (y<=70) then input(x);
      if (x>=253) and (x<=306) and (y>=52) and (y<=70) then output(x);
      if (x>=148) and (x<=308) and (y>=106) and (y<=128) then padput;
      if (x>=74) and (x<=84) and (y>=140) and (y<=150) then knopbov;
      if (x>=74) and (x<=84) and (y>=189) and (y<=199) then knopond;
      {if (x>=74) and (x<=84) and (y>=141) and (y<=188) then knopje;}
      if (x>=64) and (x<=72) and (y>=166) and (y<=172) then schrijfin(64,166,k10);
      if (x>=247) and (x<=255) and (y>=155) and (y<=161) then schrijfin(247,155,k1);
      if (x>=274) and (x<=282) and (y>=155) and (y<=161) then schrijfin(274,155,k2);
      if (x>=247) and (x<=255) and (y>=165) and (y<=171) then schrijfin(247,165,k4);
      if (x>=274) and (x<=282) and (y>=165) and (y<=171) then schrijfin(274,165,k5);
      if (x>=254) and (x<=262) and (y>=184) and (y<=190) then schrijfin(254,184,k7);
      if (x>=278) and (x<=286) and (y>=184) and (y<=190) then schrijfin(278,184,k8);
   end;

procedure zetinup(var s:string);
   begin
      if pos('TURBO.EXE',s) > 0 then
         s := copy(s,1,pos('TURBO.EXE',s)-1);
      if pos('SPRITER.EXE',s) > 0 then
         s := copy(s,1,pos('SPRITER.EXE',s)-1);
   end;

procedure muisaandr;
   begin
      xgrensmuis(8,620);
      ygrensmuis(4,192);
      repeat
         x5:=muisx;
         y5:=muisy;
         writerec;
         if knop(1) then checkleft(x5,y5,1);
         if knop(2) then checkleft(x5,y5,2);
         {if keyss[1]=true then rep:=1;}
         if keyss[19] then
            begin
               st:=false;
               rset;
               keyss[19]:=false;
            end;
      until rep=1;
      keyss[1]:=false;
   end;

{procedure keybaandr;
   begin
      kadertje((rkx1+1)*4,(rkx2+2)*4,(rky1+1)*4,(rky2+2)*4,4);
      kadertje(kx1,kx1+5,ky1,ky1+5,15);
      kadertje(kx3,kx3+4,ky3,ky3+4,15);
      repeat
         selectkleur;
         zetkleur;
      until rep=1;
   end;}

procedure roset;
   begin
      chk1:=153;
      code:=0;
      pad:=paramstr(0);
      zetinup(pad);
      k1:=1; k2:=32; k3:=32;
      k4:=1; k5:=32; k6:=32;
      k7:=1; k8:=01; k9:=01;
      k10:=1;
      x5:=168;y5:=32;
      kx1:= 91;ky1:=144;
      kx2:= kx1;ky2:=ky1;
      kx3:=4;ky3:=4;
      kx4:=kx3;ky4:=ky3;
      kx5:=153;ky5:=16;
      rkx1:=0;rky1:=0;
      rkx2:=31;rky2:=31;
      rep:=0;
      kleur1:=0;
      kleur2:=0;
      fil1:=deff;fil2:=deff;
      initgr($13);
      scherm;
      for i:=0 to 7 do for j:=0 to 7 do
         begin
            bg^[j,i]:=scrn[y5+j,x5+i];
         end;
      resetmuis;
      zetmuisop(x5*2,y5);
      if st=true then
         begin
            writerec;
            for i:=0 to 7 do for j:=0 to 7 do
                if muisc[j,i]<>0 then scrn[j+y5,i+x5]:=muisc[j,i];
         end;
      if st=true then muisaandr;
      {if st<>true then keybaandr;}
   end;

begin
   pad:=paramstr(0);
   zetinup(pad);
   getintvec(9,@p);
   setintvec(9,@keys);
   getmem(bg,64);
   {getmem(iga,61440);}
   getmem(clip,1026);
   for i:=0 to 7 do for j:=0 to 7 do bg^[i,j]:=0;
   assign(f,pad + 'spriter.dat');
   {$I-}
   reset(f,1);
   {$I+}
   if ioresult=0 then
      begin
         blockread(f,muisc,64);
         blockread(f,font2,885);
         blockread(f,def,15);
         blockread(f,t,768);
         close(f);
         setrgbpalette(0,768,seg(t),ofs(t));
         roset;
         initgr($3);
         textmode(co80);
      end
      else writeln('SPRITER.DAT not found. Please re-install in same directory!');
   freemem(clip,1026);
   {freemem(iga,61440);}
   freemem(bg,64);
   setintvec(9,@p);
   clrscr;
   {textcolor(10);
   textbackground(2);
   writeln('╔[■]══════════════════════════════════════════════════════════════════════════╗');
   for i:=2 to 18 do
   writeln('║                                                                             ║');
   writeln('╚═════════════════════════════════════════════════════════════════════════════╝');
   textcolor(14+blink);gotoxy(3,1);writeln('■');
   gotoxy(29,2);textcolor(4);writeln('Last Minute Notes:');
   textcolor(15);
   textbackground(0);}

   pad:=paramstr(0);
   zetinup(pad);
   gotoxy(1,20);
   assign(f,pad + 'SPRIV100.DOC');
   {$I-}
   reset(f,1);
   {$I+}
   if ioresult<>0 then writeln('SPRIV100.DOC not found.') else close(f);
   assign(f,pad + 'SPRIHIST.INS');
   {$I-}
   reset(f,1);
   {$I+}
   if ioresult<>0 then writeln('SPRIHIST.INS not found.') else close(f);
   if (st<>true) then writeln('No Mouse Found! Sorry, cannot start without it! :)')
end.